home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / doio.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  30KB  |  1,480 lines
  1. /*    doio.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Far below them they saw the white waters pour into a foaming bowl, and
  12.  * then swirl darkly about a deep oval basin in the rocks, until they found
  13.  * their way out again through a narrow gate, and flowed away, fuming and
  14.  * chattering, into calmer and more level reaches."
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  21. #include <sys/ipc.h>
  22. #ifdef HAS_MSG
  23. #include <sys/msg.h>
  24. #endif
  25. #ifdef HAS_SEM
  26. #include <sys/sem.h>
  27. #endif
  28. #ifdef HAS_SHM
  29. #include <sys/shm.h>
  30. # ifndef HAS_SHMAT_PROTOTYPE
  31.     extern Shmat_t shmat _((int, char *, int));
  32. # endif
  33. #endif
  34. #endif
  35.  
  36. #ifdef I_UTIME
  37. #include <utime.h>
  38. #endif
  39. #ifdef I_FCNTL
  40. #include <fcntl.h>
  41. #endif
  42. #ifdef I_SYS_FILE
  43. #include <sys/file.h>
  44. #endif
  45.  
  46. /* Omit -- it causes too much grief on mixed systems.
  47. #ifdef I_UNISTD
  48. #include <unistd.h>
  49. #endif
  50. */
  51.  
  52. bool
  53. do_open(gv,name,len,supplied_fp)
  54. GV *gv;
  55. register char *name;
  56. I32 len;
  57. FILE *supplied_fp;
  58. {
  59.     FILE *fp;
  60.     register IO *io = GvIOn(gv);
  61.     char *myname = savepv(name);
  62.     int result;
  63.     int fd;
  64.     int writing = 0;
  65.     int dodup;
  66.     char mode[3];        /* stdio file mode ("r\0" or "r+\0") */
  67.     FILE *saveifp = Nullfp;
  68.     FILE *saveofp = Nullfp;
  69.     char savetype = ' ';
  70.  
  71.     SAVEFREEPV(myname);
  72.     mode[0] = mode[1] = mode[2] = '\0';
  73.     name = myname;
  74.     forkprocess = 1;        /* assume true if no fork */
  75.     while (len && isSPACE(name[len-1]))
  76.     name[--len] = '\0';
  77.     if (IoIFP(io)) {
  78.     fd = fileno(IoIFP(io));
  79.     if (IoTYPE(io) == '-')
  80.         result = 0;
  81.     else if (fd <= maxsysfd) {
  82.         saveifp = IoIFP(io);
  83.         saveofp = IoOFP(io);
  84.         savetype = IoTYPE(io);
  85.         result = 0;
  86.     }
  87.     else if (IoTYPE(io) == '|')
  88.         result = my_pclose(IoIFP(io));
  89.     else if (IoIFP(io) != IoOFP(io)) {
  90.         if (IoOFP(io)) {
  91.         result = fclose(IoOFP(io));
  92.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  93.         }
  94.         else
  95.         result = fclose(IoIFP(io));
  96.     }
  97.     else
  98.         result = fclose(IoIFP(io));
  99.     if (result == EOF && fd > maxsysfd)
  100.         fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
  101.           GvENAME(gv));
  102.     IoOFP(io) = IoIFP(io) = Nullfp;
  103.     }
  104.     if (*name == '+' && len > 1 && name[len-1] != '|') {    /* scary */
  105.     mode[1] = *name++;
  106.     mode[2] = '\0';
  107.     --len;
  108.     writing = 1;
  109.     }
  110.     else  {
  111.     mode[1] = '\0';
  112.     }
  113.     IoTYPE(io) = *name;
  114.     if (*name == '|') {
  115.     /*SUPPRESS 530*/
  116.     for (name++; isSPACE(*name); name++) ;
  117.     if (strNE(name,"-"))
  118.         TAINT_ENV();
  119.     TAINT_PROPER("piped open");
  120.     if (dowarn && name[strlen(name)-1] == '|')
  121.         warn("Can't do bidirectional pipe");
  122.     fp = my_popen(name,"w");
  123.     writing = 1;
  124.     }
  125.     else if (*name == '>') {
  126.     TAINT_PROPER("open");
  127.     name++;
  128.     if (*name == '>') {
  129.         mode[0] = IoTYPE(io) = 'a';
  130.         name++;
  131.     }
  132.     else
  133.         mode[0] = 'w';
  134.     writing = 1;
  135.     if (*name == '&') {
  136.       duplicity:
  137.         dodup = 1;
  138.         name++;
  139.         if (*name == '=') {
  140.         dodup = 0;
  141.         name++;
  142.         }
  143.         if (!*name && supplied_fp)
  144.         fp = supplied_fp;
  145.         else {
  146.         while (isSPACE(*name))
  147.             name++;
  148.         if (isDIGIT(*name))
  149.             fd = atoi(name);
  150.         else {
  151.             IO* thatio;
  152.             gv = gv_fetchpv(name,FALSE,SVt_PVIO);
  153.             thatio = GvIO(gv);
  154.             if (!thatio) {
  155. #ifdef EINVAL
  156.             errno = EINVAL;
  157. #endif
  158.             goto say_false;
  159.             }
  160.             if (IoIFP(thatio)) {
  161.             fd = fileno(IoIFP(thatio));
  162.             if (IoTYPE(thatio) == 's')
  163.                 IoTYPE(io) = 's';
  164.             }
  165.             else
  166.             fd = -1;
  167.         }
  168.         if (dodup)
  169.             fd = dup(fd);
  170.         if (!(fp = fdopen(fd,mode)))
  171.             close(fd);
  172.         }
  173.     }
  174.     else {
  175.         while (isSPACE(*name))
  176.         name++;
  177.         if (strEQ(name,"-")) {
  178.         fp = stdout;
  179.         IoTYPE(io) = '-';
  180.         }
  181.         else  {
  182.         fp = fopen(name,mode);
  183.         }
  184.     }
  185.     }
  186.     else {
  187.     if (*name == '<') {
  188.         mode[0] = 'r';
  189.         name++;
  190.         while (isSPACE(*name))
  191.         name++;
  192.         if (*name == '&')
  193.         goto duplicity;
  194.         if (strEQ(name,"-")) {
  195.         fp = stdin;
  196.         IoTYPE(io) = '-';
  197.         }
  198.         else
  199.         fp = fopen(name,mode);
  200.     }
  201.     else if (name[len-1] == '|') {
  202.         name[--len] = '\0';
  203.         while (len && isSPACE(name[len-1]))
  204.         name[--len] = '\0';
  205.         /*SUPPRESS 530*/
  206.         for (; isSPACE(*name); name++) ;
  207.         if (strNE(name,"-"))
  208.         TAINT_ENV();
  209.         TAINT_PROPER("piped open");
  210.         fp = my_popen(name,"r");
  211.         IoTYPE(io) = '|';
  212.     }
  213.     else {
  214.         IoTYPE(io) = '<';
  215.         /*SUPPRESS 530*/
  216.         for (; isSPACE(*name); name++) ;
  217.         if (strEQ(name,"-")) {
  218.         fp = stdin;
  219.         IoTYPE(io) = '-';
  220.         }
  221.         else
  222.         fp = fopen(name,"r");
  223.     }
  224.     }
  225.     if (!fp) {
  226.     if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
  227.         warn(warn_nl, "open");
  228.     goto say_false;
  229.     }
  230.     if (IoTYPE(io) &&
  231.       IoTYPE(io) != '|' && IoTYPE(io) != '-') {
  232.     if (Fstat(fileno(fp),&statbuf) < 0) {
  233.         (void)fclose(fp);
  234.         goto say_false;
  235.     }
  236.     if (S_ISSOCK(statbuf.st_mode))
  237.         IoTYPE(io) = 's';    /* in case a socket was passed in to us */
  238. #ifdef HAS_SOCKET
  239.     else if (
  240. #ifdef S_IFMT
  241.         !(statbuf.st_mode & S_IFMT)
  242. #else
  243.         !statbuf.st_mode
  244. #endif
  245.     ) {
  246.         int buflen = sizeof tokenbuf;
  247.         if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
  248.         || errno != ENOTSOCK)
  249.         IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
  250.                 /* but some return 0 for streams too, sigh */
  251.     }
  252. #endif
  253.     }
  254.     if (saveifp) {        /* must use old fp? */
  255.     fd = fileno(saveifp);
  256.     if (saveofp) {
  257.         fflush(saveofp);        /* emulate fclose() */
  258.         if (saveofp != saveifp) {    /* was a socket? */
  259.         fclose(saveofp);
  260.         if (fd > 2)
  261.             Safefree(saveofp);
  262.         }
  263.     }
  264.     if (fd != fileno(fp)) {
  265.         int pid;
  266.         SV *sv;
  267.  
  268.         dup2(fileno(fp), fd);
  269.         sv = *av_fetch(fdpid,fileno(fp),TRUE);
  270.         (void)SvUPGRADE(sv, SVt_IV);
  271.         pid = SvIVX(sv);
  272.         SvIVX(sv) = 0;
  273.         sv = *av_fetch(fdpid,fd,TRUE);
  274.         (void)SvUPGRADE(sv, SVt_IV);
  275.         SvIVX(sv) = pid;
  276.         fclose(fp);
  277.  
  278.     }
  279.     fp = saveifp;
  280.     clearerr(fp);
  281.     }
  282. #if defined(HAS_FCNTL) && defined(F_SETFD)
  283.     fd = fileno(fp);
  284.     fcntl(fd,F_SETFD,fd > maxsysfd);
  285. #endif
  286.     IoIFP(io) = fp;
  287.     if (writing) {
  288.     if (IoTYPE(io) == 's'
  289.       || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
  290.         if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
  291.         fclose(fp);
  292.         IoIFP(io) = Nullfp;
  293.         goto say_false;
  294.         }
  295.     }
  296.     else
  297.         IoOFP(io) = fp;
  298.     }
  299.     return TRUE;
  300.  
  301. say_false:
  302.     IoIFP(io) = saveifp;
  303.     IoOFP(io) = saveofp;
  304.     IoTYPE(io) = savetype;
  305.     return FALSE;
  306. }
  307.  
  308. FILE *
  309. nextargv(gv)
  310. register GV *gv;
  311. {
  312.     register SV *sv;
  313. #ifndef FLEXFILENAMES
  314.     int filedev;
  315.     int fileino;
  316. #endif
  317.     int fileuid;
  318.     int filegid;
  319.  
  320.     if (!argvoutgv)
  321.     argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
  322.     if (filemode & (S_ISUID|S_ISGID)) {
  323.     fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
  324. #ifdef HAS_FCHMOD
  325.     (void)fchmod(lastfd,filemode);
  326. #else
  327.     (void)chmod(oldname,filemode);
  328. #endif
  329.     }
  330.     filemode = 0;
  331.     while (av_len(GvAV(gv)) >= 0) {
  332.     STRLEN len;
  333.     sv = av_shift(GvAV(gv));
  334.     SAVEFREESV(sv);
  335.     sv_setsv(GvSV(gv),sv);
  336.     SvSETMAGIC(GvSV(gv));
  337.     oldname = SvPVx(GvSV(gv), len);
  338.     if (do_open(gv,oldname,len,Nullfp)) {
  339.         if (inplace) {
  340.         TAINT_PROPER("inplace open");
  341.         if (strEQ(oldname,"-")) {
  342.             defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
  343.             return IoIFP(GvIOp(gv));
  344.         }
  345. #ifndef FLEXFILENAMES
  346.         filedev = statbuf.st_dev;
  347.         fileino = statbuf.st_ino;
  348. #endif
  349.         filemode = statbuf.st_mode;
  350.         fileuid = statbuf.st_uid;
  351.         filegid = statbuf.st_gid;
  352.         if (!S_ISREG(filemode)) {
  353.             warn("Can't do inplace edit: %s is not a regular file",
  354.               oldname );
  355.             do_close(gv,FALSE);
  356.             continue;
  357.         }
  358.         if (*inplace) {
  359. #ifdef SUFFIX
  360.             add_suffix(sv,inplace);
  361. #else
  362.             sv_catpv(sv,inplace);
  363. #endif
  364. #ifndef FLEXFILENAMES
  365.             if (Stat(SvPVX(sv),&statbuf) >= 0
  366.               && statbuf.st_dev == filedev
  367.               && statbuf.st_ino == fileino ) {
  368.             warn("Can't do inplace edit: %s > 14 characters",
  369.               SvPVX(sv) );
  370.             do_close(gv,FALSE);
  371.             continue;
  372.             }
  373. #endif
  374. #ifdef HAS_RENAME
  375. #ifndef DOSISH
  376.             if (rename(oldname,SvPVX(sv)) < 0) {
  377.             warn("Can't rename %s to %s: %s, skipping file",
  378.               oldname, SvPVX(sv), Strerror(errno) );
  379.             do_close(gv,FALSE);
  380.             continue;
  381.             }
  382. #else
  383.             do_close(gv,FALSE);
  384.             (void)unlink(SvPVX(sv));
  385.             (void)rename(oldname,SvPVX(sv));
  386.             do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp);
  387. #endif /* MSDOS */
  388. #else
  389.             (void)UNLINK(SvPVX(sv));
  390.             if (link(oldname,SvPVX(sv)) < 0) {
  391.             warn("Can't rename %s to %s: %s, skipping file",
  392.               oldname, SvPVX(sv), Strerror(errno) );
  393.             do_close(gv,FALSE);
  394.             continue;
  395.             }
  396.             (void)UNLINK(oldname);
  397. #endif
  398.         }
  399.         else {
  400. #ifndef DOSISH
  401.             if (UNLINK(oldname) < 0) {
  402.             warn("Can't rename %s to %s: %s, skipping file",
  403.               oldname, SvPVX(sv), Strerror(errno) );
  404.             do_close(gv,FALSE);
  405.             continue;
  406.             }
  407. #else
  408.             croak("Can't do inplace edit without backup");
  409. #endif
  410.         }
  411.  
  412.         sv_setpvn(sv,">",1);
  413.         sv_catpv(sv,oldname);
  414.         errno = 0;        /* in case sprintf set errno */
  415.         if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) {
  416.             warn("Can't do inplace edit on %s: %s",
  417.               oldname, Strerror(errno) );
  418.             do_close(gv,FALSE);
  419.             continue;
  420.         }
  421.         defoutgv = argvoutgv;
  422.         lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
  423.         (void)Fstat(lastfd,&statbuf);
  424. #ifdef HAS_FCHMOD
  425.         (void)fchmod(lastfd,filemode);
  426. #else
  427.         (void)chmod(oldname,filemode);
  428. #endif
  429.         if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
  430. #ifdef HAS_FCHOWN
  431.             (void)fchown(lastfd,fileuid,filegid);
  432. #else
  433. #ifdef HAS_CHOWN
  434.             (void)chown(oldname,fileuid,filegid);
  435. #endif
  436. #endif
  437.         }
  438.         }
  439.         return IoIFP(GvIOp(gv));
  440.     }
  441.     else
  442.         fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  443.     }
  444.     if (inplace) {
  445.     (void)do_close(argvoutgv,FALSE);
  446.     defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
  447.     }
  448.     return Nullfp;
  449. }
  450.  
  451. #ifdef HAS_PIPE
  452. void
  453. do_pipe(sv, rgv, wgv)
  454. SV *sv;
  455. GV *rgv;
  456. GV *wgv;
  457. {
  458.     register IO *rstio;
  459.     register IO *wstio;
  460.     int fd[2];
  461.  
  462.     if (!rgv)
  463.     goto badexit;
  464.     if (!wgv)
  465.     goto badexit;
  466.  
  467.     rstio = GvIOn(rgv);
  468.     wstio = GvIOn(wgv);
  469.  
  470.     if (IoIFP(rstio))
  471.     do_close(rgv,FALSE);
  472.     if (IoIFP(wstio))
  473.     do_close(wgv,FALSE);
  474.  
  475.     if (pipe(fd) < 0)
  476.     goto badexit;
  477.     IoIFP(rstio) = fdopen(fd[0], "r");
  478.     IoOFP(wstio) = fdopen(fd[1], "w");
  479.     IoIFP(wstio) = IoOFP(wstio);
  480.     IoTYPE(rstio) = '<';
  481.     IoTYPE(wstio) = '>';
  482.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  483.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  484.     else close(fd[0]);
  485.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  486.     else close(fd[1]);
  487.     goto badexit;
  488.     }
  489.  
  490.     sv_setsv(sv,&sv_yes);
  491.     return;
  492.  
  493. badexit:
  494.     sv_setsv(sv,&sv_undef);
  495.     return;
  496. }
  497. #endif
  498.  
  499. bool
  500. #ifndef CAN_PROTOTYPE
  501. do_close(gv,explicit)
  502. GV *gv;
  503. bool explicit;
  504. #else
  505. do_close(GV *gv, bool explicit)
  506. #endif /* CAN_PROTOTYPE */
  507. {
  508.     bool retval = FALSE;
  509.     register IO *io;
  510.     int status;
  511.  
  512.     if (!gv)
  513.     gv = argvgv;
  514.     if (!gv || SvTYPE(gv) != SVt_PVGV) {
  515.     errno = EBADF;
  516.     return FALSE;
  517.     }
  518.     io = GvIO(gv);
  519.     if (!io) {        /* never opened */
  520.     if (dowarn && explicit)
  521.         warn("Close on unopened file <%s>",GvENAME(gv));
  522.     return FALSE;
  523.     }
  524.     if (IoIFP(io)) {
  525.     if (IoTYPE(io) == '|') {
  526.         status = my_pclose(IoIFP(io));
  527.         retval = (status == 0);
  528.         statusvalue = (unsigned short)status & 0xffff;
  529.     }
  530.     else if (IoTYPE(io) == '-')
  531.         retval = TRUE;
  532.     else {
  533.         if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {        /* a socket */
  534.         retval = (fclose(IoOFP(io)) != EOF);
  535.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  536.         }
  537.         else
  538.         retval = (fclose(IoIFP(io)) != EOF);
  539.     }
  540.     IoOFP(io) = IoIFP(io) = Nullfp;
  541.     }
  542.     if (explicit) {
  543.     IoLINES(io) = 0;
  544.     IoPAGE(io) = 0;
  545.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  546.     }
  547.     IoTYPE(io) = ' ';
  548.     return retval;
  549. }
  550.  
  551. bool
  552. do_eof(gv)
  553. GV *gv;
  554. {
  555.     register IO *io;
  556.     int ch;
  557.  
  558.     io = GvIO(gv);
  559.  
  560.     if (!io)
  561.     return TRUE;
  562.  
  563.     while (IoIFP(io)) {
  564.  
  565. #ifdef USE_STD_STDIO            /* (the code works without this) */
  566.     if (IoIFP(io)->_cnt > 0)    /* cheat a little, since */
  567.         return FALSE;        /* this is the most usual case */
  568. #endif
  569.  
  570.     ch = getc(IoIFP(io));
  571.     if (ch != EOF) {
  572.         (void)ungetc(ch, IoIFP(io));
  573.         return FALSE;
  574.     }
  575. #ifdef USE_STD_STDIO
  576.     if (IoIFP(io)->_cnt < -1)
  577.         IoIFP(io)->_cnt = -1;
  578. #endif
  579.     if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
  580.         if (!nextargv(argvgv))    /* get another fp handy */
  581.         return TRUE;
  582.     }
  583.     else
  584.         return TRUE;        /* normal fp, definitely end of file */
  585.     }
  586.     return TRUE;
  587. }
  588.  
  589. long
  590. do_tell(gv)
  591. GV *gv;
  592. {
  593.     register IO *io;
  594.  
  595.     if (!gv)
  596.     goto phooey;
  597.  
  598.     io = GvIO(gv);
  599.     if (!io || !IoIFP(io))
  600.     goto phooey;
  601.  
  602. #ifdef ULTRIX_STDIO_BOTCH
  603.     if (feof(IoIFP(io)))
  604.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  605. #endif
  606.  
  607.     return ftell(IoIFP(io));
  608.  
  609. phooey:
  610.     if (dowarn)
  611.     warn("tell() on unopened file");
  612.     errno = EBADF;
  613.     return -1L;
  614. }
  615.  
  616. bool
  617. do_seek(gv, pos, whence)
  618. GV *gv;
  619. long pos;
  620. int whence;
  621. {
  622.     register IO *io;
  623.  
  624.     if (!gv)
  625.     goto nuts;
  626.  
  627.     io = GvIO(gv);
  628.     if (!io || !IoIFP(io))
  629.     goto nuts;
  630.  
  631. #ifdef ULTRIX_STDIO_BOTCH
  632.     if (feof(IoIFP(io)))
  633.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  634. #endif
  635.  
  636.     return fseek(IoIFP(io), pos, whence) >= 0;
  637.  
  638. nuts:
  639.     if (dowarn)
  640.     warn("seek() on unopened file");
  641.     errno = EBADF;
  642.     return FALSE;
  643. }
  644.  
  645. #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
  646.     /* code courtesy of William Kucharski */
  647. #define HAS_CHSIZE
  648.  
  649. I32 chsize(fd, length)
  650. I32 fd;            /* file descriptor */
  651. Off_t length;        /* length to set file to */
  652. {
  653.     extern long lseek();
  654.     struct flock fl;
  655.     struct stat filebuf;
  656.  
  657.     if (Fstat(fd, &filebuf) < 0)
  658.     return -1;
  659.  
  660.     if (filebuf.st_size < length) {
  661.  
  662.     /* extend file length */
  663.  
  664.     if ((lseek(fd, (length - 1), 0)) < 0)
  665.         return -1;
  666.  
  667.     /* write a "0" byte */
  668.  
  669.     if ((write(fd, "", 1)) != 1)
  670.         return -1;
  671.     }
  672.     else {
  673.     /* truncate length */
  674.  
  675.     fl.l_whence = 0;
  676.     fl.l_len = 0;
  677.     fl.l_start = length;
  678.     fl.l_type = F_WRLCK;    /* write lock on file space */
  679.  
  680.     /*
  681.     * This relies on the UNDOCUMENTED F_FREESP argument to
  682.     * fcntl(2), which truncates the file so that it ends at the
  683.     * position indicated by fl.l_start.
  684.     *
  685.     * Will minor miracles never cease?
  686.     */
  687.  
  688.     if (fcntl(fd, F_FREESP, &fl) < 0)
  689.         return -1;
  690.  
  691.     }
  692.  
  693.     return 0;
  694. }
  695. #endif /* F_FREESP */
  696.  
  697. I32
  698. looks_like_number(sv)
  699. SV *sv;
  700. {
  701.     register char *s;
  702.     register char *send;
  703.  
  704.     if (!SvPOK(sv)) {
  705.     STRLEN len;
  706.     if (!SvPOKp(sv))
  707.         return TRUE;
  708.     s = SvPV(sv, len);
  709.     send = s + len;
  710.     }
  711.     else {
  712.     s = SvPVX(sv); 
  713.     send = s + SvCUR(sv);
  714.     }
  715.     while (isSPACE(*s))
  716.     s++;
  717.     if (s >= send)
  718.     return FALSE;
  719.     if (*s == '+' || *s == '-')
  720.     s++;
  721.     while (isDIGIT(*s))
  722.     s++;
  723.     if (s == send)
  724.     return TRUE;
  725.     if (*s == '.') 
  726.     s++;
  727.     else if (s == SvPVX(sv))
  728.     return FALSE;
  729.     while (isDIGIT(*s))
  730.     s++;
  731.     if (s == send)
  732.     return TRUE;
  733.     if (*s == 'e' || *s == 'E') {
  734.     s++;
  735.     if (*s == '+' || *s == '-')
  736.         s++;
  737.     while (isDIGIT(*s))
  738.         s++;
  739.     }
  740.     while (isSPACE(*s))
  741.     s++;
  742.     if (s >= send)
  743.     return TRUE;
  744.     return FALSE;
  745. }
  746.  
  747. bool
  748. do_print(sv,fp)
  749. register SV *sv;
  750. FILE *fp;
  751. {
  752.     register char *tmps;
  753.     STRLEN len;
  754.  
  755.     /* assuming fp is checked earlier */
  756.     if (!sv)
  757.     return TRUE;
  758.     if (ofmt) {
  759.     if (SvGMAGICAL(sv))
  760.         mg_get(sv);
  761.         if (SvIOK(sv) && SvIVX(sv) != 0) {
  762.         fprintf(fp, ofmt, (double)SvIVX(sv));
  763.         return !ferror(fp);
  764.     }
  765.     if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
  766.        || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
  767.         fprintf(fp, ofmt, SvNVX(sv));
  768.         return !ferror(fp);
  769.     }
  770.     }
  771.     switch (SvTYPE(sv)) {
  772.     case SVt_NULL:
  773.     if (dowarn)
  774.         warn(warn_uninit);
  775.     return TRUE;
  776.     case SVt_IV:
  777.     if (SvIOK(sv)) {
  778.         if (SvGMAGICAL(sv))
  779.         mg_get(sv);
  780.         fprintf(fp, "%ld", (long)SvIVX(sv));
  781.         return !ferror(fp);
  782.     }
  783.     /* FALL THROUGH */
  784.     default:
  785.     tmps = SvPV(sv, len);
  786.     break;
  787.     }
  788.     if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
  789.     return FALSE;
  790.     return TRUE;
  791. }
  792.  
  793. I32
  794. my_stat(ARGS)
  795. dARGS
  796. {
  797.     dSP;
  798.     IO *io;
  799.  
  800.     if (op->op_flags & OPf_REF) {
  801.     EXTEND(sp,1);
  802.     io = GvIO(cGVOP->op_gv);
  803.     if (io && IoIFP(io)) {
  804.         statgv = cGVOP->op_gv;
  805.         sv_setpv(statname,"");
  806.         laststype = OP_STAT;
  807.         return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
  808.     }
  809.     else {
  810.         if (cGVOP->op_gv == defgv)
  811.         return laststatval;
  812.         if (dowarn)
  813.         warn("Stat on unopened file <%s>",
  814.           GvENAME(cGVOP->op_gv));
  815.         statgv = Nullgv;
  816.         sv_setpv(statname,"");
  817.         return (laststatval = -1);
  818.     }
  819.     }
  820.     else {
  821.     dPOPss;
  822.     PUTBACK;
  823.     statgv = Nullgv;
  824.     sv_setpv(statname,SvPV(sv, na));
  825.     laststype = OP_STAT;
  826.     laststatval = Stat(SvPV(sv, na),&statcache);
  827.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  828.         warn(warn_nl, "stat");
  829.     return laststatval;
  830.     }
  831. }
  832.  
  833. I32
  834. my_lstat(ARGS)
  835. dARGS
  836. {
  837.     dSP;
  838.     SV *sv;
  839.     if (op->op_flags & OPf_REF) {
  840.     EXTEND(sp,1);
  841.     if (cGVOP->op_gv == defgv) {
  842.         if (laststype != OP_LSTAT)
  843.         croak("The stat preceding -l _ wasn't an lstat");
  844.         return laststatval;
  845.     }
  846.     croak("You can't use -l on a filehandle");
  847.     }
  848.  
  849.     laststype = OP_LSTAT;
  850.     statgv = Nullgv;
  851.     sv = POPs;
  852.     PUTBACK;
  853.     sv_setpv(statname,SvPV(sv, na));
  854. #ifdef HAS_LSTAT
  855.     laststatval = lstat(SvPV(sv, na),&statcache);
  856. #else
  857.     laststatval = Stat(SvPV(sv, na),&statcache);
  858. #endif
  859.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  860.     warn(warn_nl, "lstat");
  861.     return laststatval;
  862. }
  863.  
  864. bool
  865. do_aexec(really,mark,sp)
  866. SV *really;
  867. register SV **mark;
  868. register SV **sp;
  869. {
  870.     register char **a;
  871.     char *tmps;
  872.  
  873.     if (sp > mark) {
  874.     New(401,Argv, sp - mark + 1, char*);
  875.     a = Argv;
  876.     while (++mark <= sp) {
  877.         if (*mark)
  878.         *a++ = SvPVx(*mark, na);
  879.         else
  880.         *a++ = "";
  881.     }
  882.     *a = Nullch;
  883.     if (*Argv[0] != '/')    /* will execvp use PATH? */
  884.         TAINT_ENV();        /* testing IFS here is overkill, probably */
  885.     if (really && *(tmps = SvPV(really, na)))
  886.         execvp(tmps,Argv);
  887.     else
  888.         execvp(Argv[0],Argv);
  889.     if (dowarn)
  890.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  891.     }
  892.     do_execfree();
  893.     return FALSE;
  894. }
  895.  
  896. void
  897. do_execfree()
  898. {
  899.     if (Argv) {
  900.     Safefree(Argv);
  901.     Argv = Null(char **);
  902.     }
  903.     if (Cmd) {
  904.     Safefree(Cmd);
  905.     Cmd = Nullch;
  906.     }
  907. }
  908.  
  909. bool
  910. do_exec(cmd)
  911. char *cmd;
  912. {
  913.     register char **a;
  914.     register char *s;
  915.     char flags[10];
  916.  
  917.     /* save an extra exec if possible */
  918.  
  919. #ifdef CSH
  920.     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
  921.     strcpy(flags,"-c");
  922.     s = cmd+cshlen+3;
  923.     if (*s == 'f') {
  924.         s++;
  925.         strcat(flags,"f");
  926.     }
  927.     if (*s == ' ')
  928.         s++;
  929.     if (*s++ == '\'') {
  930.         char *ncmd = s;
  931.  
  932.         while (*s)
  933.         s++;
  934.         if (s[-1] == '\n')
  935.         *--s = '\0';
  936.         if (s[-1] == '\'') {
  937.         *--s = '\0';
  938.         execl(cshname,"csh", flags,ncmd,(char*)0);
  939.         *s = '\'';
  940.         return FALSE;
  941.         }
  942.     }
  943.     }
  944. #endif /* CSH */
  945.  
  946.     /* see if there are shell metacharacters in it */
  947.  
  948.     /*SUPPRESS 530*/
  949.     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  950.     if (*s == '=')
  951.     goto doshell;
  952.     for (s = cmd; *s; s++) {
  953.     if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  954.         if (*s == '\n' && !s[1]) {
  955.         *s = '\0';
  956.         break;
  957.         }
  958.       doshell:
  959.         execl("/bin/sh","sh","-c",cmd,(char*)0);
  960.         return FALSE;
  961.     }
  962.     }
  963.     New(402,Argv, (s - cmd) / 2 + 2, char*);
  964.     Cmd = savepvn(cmd, s-cmd);
  965.     a = Argv;
  966.     for (s = Cmd; *s;) {
  967.     while (*s && isSPACE(*s)) s++;
  968.     if (*s)
  969.         *(a++) = s;
  970.     while (*s && !isSPACE(*s)) s++;
  971.     if (*s)
  972.         *s++ = '\0';
  973.     }
  974.     *a = Nullch;
  975.     if (Argv[0]) {
  976.     execvp(Argv[0],Argv);
  977.     if (errno == ENOEXEC) {        /* for system V NIH syndrome */
  978.         do_execfree();
  979.         goto doshell;
  980.     }
  981.     if (dowarn)
  982.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  983.     }
  984.     do_execfree();
  985.     return FALSE;
  986. }
  987.  
  988. I32
  989. apply(type,mark,sp)
  990. I32 type;
  991. register SV **mark;
  992. register SV **sp;
  993. {
  994.     register I32 val;
  995.     register I32 val2;
  996.     register I32 tot = 0;
  997.     char *s;
  998.     SV **oldmark = mark;
  999.  
  1000.     if (tainting) {
  1001.     while (++mark <= sp) {
  1002.         if (SvMAGICAL(*mark) && mg_find(*mark, 't'))
  1003.         tainted = TRUE;
  1004.     }
  1005.     mark = oldmark;
  1006.     }
  1007.     switch (type) {
  1008.     case OP_CHMOD:
  1009.     TAINT_PROPER("chmod");
  1010.     if (++mark <= sp) {
  1011.         tot = sp - mark;
  1012.         val = SvIVx(*mark);
  1013.         while (++mark <= sp) {
  1014.         if (chmod(SvPVx(*mark, na),val))
  1015.             tot--;
  1016.         }
  1017.     }
  1018.     break;
  1019. #ifdef HAS_CHOWN
  1020.     case OP_CHOWN:
  1021.     TAINT_PROPER("chown");
  1022.     if (sp - mark > 2) {
  1023.         val = SvIVx(*++mark);
  1024.         val2 = SvIVx(*++mark);
  1025.         tot = sp - mark;
  1026.         while (++mark <= sp) {
  1027.         if (chown(SvPVx(*mark, na),val,val2))
  1028.             tot--;
  1029.         }
  1030.     }
  1031.     break;
  1032. #endif
  1033. #ifdef HAS_KILL
  1034.     case OP_KILL:
  1035.     TAINT_PROPER("kill");
  1036.     s = SvPVx(*++mark, na);
  1037.     tot = sp - mark;
  1038.     if (isUPPER(*s)) {
  1039.         if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  1040.         s += 3;
  1041.         if (!(val = whichsig(s)))
  1042.         croak("Unrecognized signal name \"%s\"",s);
  1043.     }
  1044.     else
  1045.         val = SvIVx(*mark);
  1046.     if (val < 0) {
  1047.         val = -val;
  1048.         while (++mark <= sp) {
  1049.         I32 proc = SvIVx(*mark);
  1050. #ifdef HAS_KILLPG
  1051.         if (killpg(proc,val))    /* BSD */
  1052. #else
  1053.         if (kill(-proc,val))    /* SYSV */
  1054. #endif
  1055.             tot--;
  1056.         }
  1057.     }
  1058.     else {
  1059.         while (++mark <= sp) {
  1060.         if (kill(SvIVx(*mark),val))
  1061.             tot--;
  1062.         }
  1063.     }
  1064.     break;
  1065. #endif
  1066.     case OP_UNLINK:
  1067.     TAINT_PROPER("unlink");
  1068.     tot = sp - mark;
  1069.     while (++mark <= sp) {
  1070.         s = SvPVx(*mark, na);
  1071.         if (euid || unsafe) {
  1072.         if (UNLINK(s))
  1073.             tot--;
  1074.         }
  1075.         else {    /* don't let root wipe out directories without -U */
  1076. #ifdef HAS_LSTAT
  1077.         if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1078. #else
  1079.         if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1080. #endif
  1081.             tot--;
  1082.         else {
  1083.             if (UNLINK(s))
  1084.             tot--;
  1085.         }
  1086.         }
  1087.     }
  1088.     break;
  1089. #ifdef HAS_UTIME
  1090.     case OP_UTIME:
  1091.     TAINT_PROPER("utime");
  1092.     if (sp - mark > 2) {
  1093. #ifdef I_UTIME
  1094.         struct utimbuf utbuf;
  1095. #else
  1096.         struct {
  1097.         long    actime;
  1098.         long    modtime;
  1099.         } utbuf;
  1100. #endif
  1101.  
  1102.         Zero(&utbuf, sizeof utbuf, char);
  1103.         utbuf.actime = SvIVx(*++mark);    /* time accessed */
  1104.         utbuf.modtime = SvIVx(*++mark);    /* time modified */
  1105.         tot = sp - mark;
  1106.         while (++mark <= sp) {
  1107.         if (utime(SvPVx(*mark, na),&utbuf))
  1108.             tot--;
  1109.         }
  1110.     }
  1111.     else
  1112.         tot = 0;
  1113.     break;
  1114. #endif
  1115.     }
  1116.     return tot;
  1117. }
  1118.  
  1119. /* Do the permissions allow some operation?  Assumes statcache already set. */
  1120. #ifndef VMS /* VMS' cando is in vms.c */
  1121. I32
  1122. cando(bit, effective, statbufp)
  1123. I32 bit;
  1124. I32 effective;
  1125. register struct stat *statbufp;
  1126. {
  1127. #ifdef DOSISH
  1128.     /* [Comments and code from Len Reed]
  1129.      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
  1130.      * to write-protected files.  The execute permission bit is set
  1131.      * by the Miscrosoft C library stat() function for the following:
  1132.      *        .exe files
  1133.      *        .com files
  1134.      *        .bat files
  1135.      *        directories
  1136.      * All files and directories are readable.
  1137.      * Directories and special files, e.g. "CON", cannot be
  1138.      * write-protected.
  1139.      * [Comment by Tom Dinger -- a directory can have the write-protect
  1140.      *        bit set in the file system, but DOS permits changes to
  1141.      *        the directory anyway.  In addition, all bets are off
  1142.      *        here for networked software, such as Novell and
  1143.      *        Sun's PC-NFS.]
  1144.      */
  1145.  
  1146.      /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
  1147.       * too so it will actually look into the files for magic numbers
  1148.       */
  1149.      return (bit & statbufp->st_mode) ? TRUE : FALSE;
  1150.  
  1151. #else /* ! MSDOS */
  1152.     if ((effective ? euid : uid) == 0) {    /* root is special */
  1153.     if (bit == S_IXUSR) {
  1154.         if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
  1155.         return TRUE;
  1156.     }
  1157.     else
  1158.         return TRUE;        /* root reads and writes anything */
  1159.     return FALSE;
  1160.     }
  1161.     if (statbufp->st_uid == (effective ? euid : uid) ) {
  1162.     if (statbufp->st_mode & bit)
  1163.         return TRUE;    /* ok as "user" */
  1164.     }
  1165.     else if (ingroup((I32)statbufp->st_gid,effective)) {
  1166.     if (statbufp->st_mode & bit >> 3)
  1167.         return TRUE;    /* ok as "group" */
  1168.     }
  1169.     else if (statbufp->st_mode & bit >> 6)
  1170.     return TRUE;    /* ok as "other" */
  1171.     return FALSE;
  1172. #endif /* ! MSDOS */
  1173. }
  1174. #endif /* ! VMS */
  1175.  
  1176. I32
  1177. ingroup(testgid,effective)
  1178. I32 testgid;
  1179. I32 effective;
  1180. {
  1181.     if (testgid == (effective ? egid : gid))
  1182.     return TRUE;
  1183. #ifdef HAS_GETGROUPS
  1184. #ifndef NGROUPS
  1185. #define NGROUPS 32
  1186. #endif
  1187.     {
  1188.     Groups_t gary[NGROUPS];
  1189.     I32 anum;
  1190.  
  1191.     anum = getgroups(NGROUPS,gary);
  1192.     while (--anum >= 0)
  1193.         if (gary[anum] == testgid)
  1194.         return TRUE;
  1195.     }
  1196. #endif
  1197.     return FALSE;
  1198. }
  1199.  
  1200. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  1201.  
  1202. I32
  1203. do_ipcget(optype, mark, sp)
  1204. I32 optype;
  1205. SV **mark;
  1206. SV **sp;
  1207. {
  1208.     key_t key;
  1209.     I32 n, flags;
  1210.  
  1211.     key = (key_t)SvNVx(*++mark);
  1212.     n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
  1213.     flags = SvIVx(*++mark);
  1214.     errno = 0;
  1215.     switch (optype)
  1216.     {
  1217. #ifdef HAS_MSG
  1218.     case OP_MSGGET:
  1219.     return msgget(key, flags);
  1220. #endif
  1221. #ifdef HAS_SEM
  1222.     case OP_SEMGET:
  1223.     return semget(key, n, flags);
  1224. #endif
  1225. #ifdef HAS_SHM
  1226.     case OP_SHMGET:
  1227.     return shmget(key, n, flags);
  1228. #endif
  1229. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1230.     default:
  1231.     croak("%s not implemented", op_name[optype]);
  1232. #endif
  1233.     }
  1234.     return -1;            /* should never happen */
  1235. }
  1236.  
  1237. I32
  1238. do_ipcctl(optype, mark, sp)
  1239. I32 optype;
  1240. SV **mark;
  1241. SV **sp;
  1242. {
  1243.     SV *astr;
  1244.     char *a;
  1245.     I32 id, n, cmd, infosize, getinfo;
  1246.     I32 ret = -1;
  1247.  
  1248.     id = SvIVx(*++mark);
  1249.     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
  1250.     cmd = SvIVx(*++mark);
  1251.     astr = *++mark;
  1252.     infosize = 0;
  1253.     getinfo = (cmd == IPC_STAT);
  1254.  
  1255.     switch (optype)
  1256.     {
  1257. #ifdef HAS_MSG
  1258.     case OP_MSGCTL:
  1259.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1260.         infosize = sizeof(struct msqid_ds);
  1261.     break;
  1262. #endif
  1263. #ifdef HAS_SHM
  1264.     case OP_SHMCTL:
  1265.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1266.         infosize = sizeof(struct shmid_ds);
  1267.     break;
  1268. #endif
  1269. #ifdef HAS_SEM
  1270.     case OP_SEMCTL:
  1271.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1272.         infosize = sizeof(struct semid_ds);
  1273.     else if (cmd == GETALL || cmd == SETALL)
  1274.     {
  1275.         struct semid_ds semds;
  1276.         if (semctl(id, 0, IPC_STAT, &semds) == -1)
  1277.         return -1;
  1278.         getinfo = (cmd == GETALL);
  1279.         infosize = semds.sem_nsems * sizeof(short);
  1280.         /* "short" is technically wrong but much more portable
  1281.            than guessing about u_?short(_t)? */
  1282.     }
  1283.     break;
  1284. #endif
  1285. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1286.     default:
  1287.     croak("%s not implemented", op_name[optype]);
  1288. #endif
  1289.     }
  1290.  
  1291.     if (infosize)
  1292.     {
  1293.     STRLEN len;
  1294.     if (getinfo)
  1295.     {
  1296.         SvPV_force(astr, len);
  1297.         a = SvGROW(astr, infosize+1);
  1298.     }
  1299.     else
  1300.     {
  1301.         a = SvPV(astr, len);
  1302.         if (len != infosize)
  1303.         croak("Bad arg length for %s, is %d, should be %d",
  1304.             op_name[optype], len, infosize);
  1305.     }
  1306.     }
  1307.     else
  1308.     {
  1309.     I32 i = SvIV(astr);
  1310.     a = (char *)i;        /* ouch */
  1311.     }
  1312.     errno = 0;
  1313.     switch (optype)
  1314.     {
  1315. #ifdef HAS_MSG
  1316.     case OP_MSGCTL:
  1317.     ret = msgctl(id, cmd, (struct msqid_ds *)a);
  1318.     break;
  1319. #endif
  1320. #ifdef HAS_SEM
  1321.     case OP_SEMCTL:
  1322.     ret = semctl(id, n, cmd, (struct semid_ds *)a);
  1323.     break;
  1324. #endif
  1325. #ifdef HAS_SHM
  1326.     case OP_SHMCTL:
  1327.     ret = shmctl(id, cmd, (struct shmid_ds *)a);
  1328.     break;
  1329. #endif
  1330.     }
  1331.     if (getinfo && ret >= 0) {
  1332.     SvCUR_set(astr, infosize);
  1333.     *SvEND(astr) = '\0';
  1334.     SvSETMAGIC(astr);
  1335.     }
  1336.     return ret;
  1337. }
  1338.  
  1339. I32
  1340. do_msgsnd(mark, sp)
  1341. SV **mark;
  1342. SV **sp;
  1343. {
  1344. #ifdef HAS_MSG
  1345.     SV *mstr;
  1346.     char *mbuf;
  1347.     I32 id, msize, flags;
  1348.     STRLEN len;
  1349.  
  1350.     id = SvIVx(*++mark);
  1351.     mstr = *++mark;
  1352.     flags = SvIVx(*++mark);
  1353.     mbuf = SvPV(mstr, len);
  1354.     if ((msize = len - sizeof(long)) < 0)
  1355.     croak("Arg too short for msgsnd");
  1356.     errno = 0;
  1357.     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
  1358. #else
  1359.     croak("msgsnd not implemented");
  1360. #endif
  1361. }
  1362.  
  1363. I32
  1364. do_msgrcv(mark, sp)
  1365. SV **mark;
  1366. SV **sp;
  1367. {
  1368. #ifdef HAS_MSG
  1369.     SV *mstr;
  1370.     char *mbuf;
  1371.     long mtype;
  1372.     I32 id, msize, flags, ret;
  1373.     STRLEN len;
  1374.  
  1375.     id = SvIVx(*++mark);
  1376.     mstr = *++mark;
  1377.     msize = SvIVx(*++mark);
  1378.     mtype = (long)SvIVx(*++mark);
  1379.     flags = SvIVx(*++mark);
  1380.     if (SvTHINKFIRST(mstr)) {
  1381.     if (SvREADONLY(mstr))
  1382.         croak("Can't msgrcv to readonly var");
  1383.     if (SvROK(mstr))
  1384.         sv_unref(mstr);
  1385.     }
  1386.     SvPV_force(mstr, len);
  1387.     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
  1388.     
  1389.     errno = 0;
  1390.     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
  1391.     if (ret >= 0) {
  1392.     SvCUR_set(mstr, sizeof(long)+ret);
  1393.     *SvEND(mstr) = '\0';
  1394.     }
  1395.     return ret;
  1396. #else
  1397.     croak("msgrcv not implemented");
  1398. #endif
  1399. }
  1400.  
  1401. I32
  1402. do_semop(mark, sp)
  1403. SV **mark;
  1404. SV **sp;
  1405. {
  1406. #ifdef HAS_SEM
  1407.     SV *opstr;
  1408.     char *opbuf;
  1409.     I32 id;
  1410.     STRLEN opsize;
  1411.  
  1412.     id = SvIVx(*++mark);
  1413.     opstr = *++mark;
  1414.     opbuf = SvPV(opstr, opsize);
  1415.     if (opsize < sizeof(struct sembuf)
  1416.     || (opsize % sizeof(struct sembuf)) != 0) {
  1417.     errno = EINVAL;
  1418.     return -1;
  1419.     }
  1420.     errno = 0;
  1421.     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
  1422. #else
  1423.     croak("semop not implemented");
  1424. #endif
  1425. }
  1426.  
  1427. I32
  1428. do_shmio(optype, mark, sp)
  1429. I32 optype;
  1430. SV **mark;
  1431. SV **sp;
  1432. {
  1433. #ifdef HAS_SHM
  1434.     SV *mstr;
  1435.     char *mbuf, *shm;
  1436.     I32 id, mpos, msize;
  1437.     STRLEN len;
  1438.     struct shmid_ds shmds;
  1439.  
  1440.     id = SvIVx(*++mark);
  1441.     mstr = *++mark;
  1442.     mpos = SvIVx(*++mark);
  1443.     msize = SvIVx(*++mark);
  1444.     errno = 0;
  1445.     if (shmctl(id, IPC_STAT, &shmds) == -1)
  1446.     return -1;
  1447.     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
  1448.     errno = EFAULT;        /* can't do as caller requested */
  1449.     return -1;
  1450.     }
  1451.     shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
  1452.     if (shm == (char *)-1)    /* I hate System V IPC, I really do */
  1453.     return -1;
  1454.     if (optype == OP_SHMREAD) {
  1455.     SvPV_force(mstr, len);
  1456.     mbuf = SvGROW(mstr, msize+1);
  1457.  
  1458.     Copy(shm + mpos, mbuf, msize, char);
  1459.     SvCUR_set(mstr, msize);
  1460.     *SvEND(mstr) = '\0';
  1461.     SvSETMAGIC(mstr);
  1462.     }
  1463.     else {
  1464.     I32 n;
  1465.  
  1466.     mbuf = SvPV(mstr, len);
  1467.     if ((n = len) > msize)
  1468.         n = msize;
  1469.     Copy(mbuf, shm + mpos, n, char);
  1470.     if (n < msize)
  1471.         memzero(shm + mpos + n, msize - n);
  1472.     }
  1473.     return shmdt(shm);
  1474. #else
  1475.     croak("shm I/O not implemented");
  1476. #endif
  1477. }
  1478.  
  1479. #endif /* SYSV IPC */
  1480.